Attribute VB_Name = "moduloAdmin"
Option Explicit
Private Function EstadoProyectoDetaConsul( _
        ByVal id As String) As String

Dim sSql As String
Dim oRs As ADODB.Recordset

On Error GoTo CapturarError
  
sSql = " SELECT ep.IDESTADOPROYECTO , ep.NOMBRE, ep.DESCRIPCION "
sSql = sSql & " FROM " & sDbAlias & "ESTADOPROYECTO ep"
sSql = sSql & " WHERE ep.IDESTADOPROYECTO = " & id
 
Set oRs = oBD.RsView(sSql)
 
EstadoProyectoDetaConsul = oBD.Rs2XML(oRs)
  
Set oRs = Nothing

Exit Function
CapturarError:
    ErrorHandler "EstadoProyectoDetaConsul"

End Function

Private Function EstadoProyectoActua( _
        ByVal sXmlActua As String) As String

Dim sSql As String
Dim oRs As ADODB.Recordset
Dim oXml As MSXML.DOMDocument
Dim id, sNombre, sDescrip As String

On Error GoTo CapturarError

Set oXml = oCtx.CreateInstance("MSXML.DOMDocument")

oXml.loadXML (sXmlActua)

id = Trim(oXml.childNodes(0).childNodes(1).Attributes(0).Text)
sNombre = oXml.childNodes(0).childNodes(1).Attributes(1).Text
sDescrip = oXml.childNodes(0).childNodes(1).Attributes(2).Text

  
If id <> "" Then 'Actualizar

    sSql = " UPDATE " & sDbAlias & "ESTADOPROYECTO "
    sSql = sSql & " SET NOMBRE = '" & sNombre & "' "
    sSql = sSql & " ,   DESCRIPCION = '" & sDescrip & "' "
    sSql = sSql & " WHERE IDESTADOPROYECTO = " & id
     
    oBD.DbExecute (sSql)
         
Else 'Agregar uno nuevo

    sSql = "SELECT (NVL(MAX(IDESTADOPROYECTO),0)+ 1) FROM " & sDbAlias & "ESTADOPROYECTO "
    
    Set oRs = oBD.RsView(CStr(sSql))

    id = CStr(oRs(0).Value)
    
    sSql = " INSERT INTO " & sDbAlias & "ESTADOPROYECTO (IDESTADOPROYECTO,NOMBRE,DESCRIPCION)"
    sSql = sSql & " VALUES (" & id & ",'" & sNombre & "','" & sDescrip & "' )"
     
    oBD.DbExecute (sSql)
     

End If

EstadoProyectoActua = "<registros><registro><id>" & id & "</id></registro></registros>"
  
Set oRs = Nothing
Set oXml = Nothing

Exit Function
CapturarError:
    ErrorHandler "EstadoProyectoActua"

End Function

Private Function EstadoProyectoConsul( _
        ByVal sXmlConsul As String) As String

Dim sSql As String
Dim oRs As ADODB.Recordset
Dim oXml As MSXML.DOMDocument
Dim sNombre As String

On Error GoTo CapturarError

Set oXml = oCtx.CreateInstance("MSXML.DOMDocument")

oXml.loadXML (sXmlConsul)

sNombre = oXml.childNodes(0).childNodes(1).Attributes(1).Text
  
sSql = " SELECT ep.IDESTADOPROYECTO , ep.NOMBRE, CONCAT(substr(ep.DESCRIPCION,0,50),'...') as Descripcion"
sSql = sSql & " FROM " & sDbAlias & "ESTADOPROYECTO ep"
sSql = sSql & " WHERE UPPER(ep.NOMBRE) LIKE '" & UCase(sNombre) & "%'"
sSql = sSql & " ORDER BY ep.NOMBRE "
 
Set oRs = oBD.RsView(sSql)
 
EstadoProyectoConsul = oBD.Rs2XML(oRs)
  
Set oRs = Nothing
Set oXml = Nothing

Exit Function
CapturarError:
    ErrorHandler "EstadoProyectoConsul"

End Function


Public Function UsuariosConsul( _
        ByVal idUsuario As String, _
        ByVal sUserName As String, _
        ByVal sNombre As String, _
        ByVal sApellido As String, _
        ByVal sEmail As String) As String

Dim sSql As String
Dim oRs As ADODB.Recordset
 
On Error GoTo CapturarError
 
 
sSql = " SELECT p.IDPERSONA , p.USERNAME, ( p.APELLIDO || ' ' || p.NOMBRE) as NOMBRE "
sSql = sSql & "               , p.EMAIL , p.DESCRIP, p.NOMBRE as NOMBREUSUARIO "
sSql = sSql & "               , p.APELLIDO as APELLIDOUSUARIO , r.NOMBRE as ROL, r.IDROL "
sSql = sSql & " FROM " & sDbAlias & "PERSONAS p, " & sDbAlias & "ROLJERARQUIAPERSONA rjp , " & sDbAlias & "ROLES r"
sSql = sSql & " WHERE p.IDPERSONA = rjp.IDPERSONA "
sSql = sSql & " AND rjp.IDROL = r.IDROL "
    
If idUsuario <> "" Then
    sSql = sSql & " AND p.IDPERSONA = " & idUsuario
End If

If Trim(sUserName) <> "" Then
    sSql = sSql & " AND UPPER(p.USERNAME) LIKE '" & UCase(Trim(sUserName)) & "%' "
End If

If Trim(sNombre) <> "" Then
    sSql = sSql & " AND UPPER(p.NOMBRE) LIKE '" & UCase(Trim(sNombre)) & "%' "
End If

If Trim(sApellido) <> "" Then
    sSql = sSql & " AND UPPER(p.APELLIDO) LIKE '" & UCase(Trim(sApellido)) & "%' "
End If

If Trim(sEmail) <> "" Then
    sSql = sSql & " AND UPPER(p.EMAIL) LIKE '" & UCase(Trim(sEmail)) & "%' "
End If

sSql = sSql & " ORDER BY 3 "
 
 Set oRs = oBD.RsView(sSql)
 
 UsuariosConsul = oBD.Rs2XML(oRs)
  
Set oRs = Nothing

Exit Function
CapturarError:
    ErrorHandler "UsuariosConsul"
End Function

Public Function UsuariosActua( _
        ByVal idUsuario As String, _
        ByVal sUserName As String, _
        ByVal idRol As String, _
        ByVal sNombre As String, _
        ByVal sApellido As String, _
        ByVal sEmail As String, _
        ByVal sDescrip As String) As String

Dim sSql As String
Dim oRs As ADODB.Recordset
Dim oXml As MSXML.DOMDocument
 
On Error GoTo CapturarError
 
Set oXml = oCtx.CreateInstance("MSXML.DOMDocument")
 
If Trim(idUsuario) = "" Then
   'Insercion de un usuario nuevo
    
    'VErifiquemos que ese username no exista
    oXml.loadXML (UsuariosConsul("", sUserName, "", "", ""))
    
    If (oXml.childNodes(0).hasChildNodes()) Then
        Set oXml = Nothing
        Set oRs = Nothing
        UsuariosActua = "-1"
        Exit Function
    End If
    
    If Trim(sNombre) = "" Then
        sNombre = "NULL"
    Else
        sNombre = "'" & sNombre & "'"
    End If
    
    If Trim(sDescrip) = "" Then
        sDescrip = "NULL"
    Else
        sDescrip = "'" & sDescrip & "'"
    End If
    
    oBD.DbTransaction (dbBegin)
    
    'TRaigo el proximo ID de Usuario
    sSql = " SELECT (NVL(MAX(IDPERSONA),0)+ 1) FROM " & sDbAlias & " PERSONAS "
    
    Set oRs = oBD.RsView(CStr(sSql))
    
    idUsuario = Trim(oRs(0).Value)
    
    'Agrego el nuevo usuario
    sSql = " INSERT INTO " & sDbAlias & "PERSONAS (IDPERSONA ,USERNAME, NOMBRE,APELLIDO ,EMAIL , DESCRIP ) "
    sSql = sSql & " VALUES ( " & idUsuario & " , '"
    sSql = sSql & Trim(sUserName) & "' , " & sNombre & " , '"
    sSql = sSql & Trim(sApellido) & "' , '" & Trim(sEmail) & "' , "
    sSql = sSql & Trim(sDescrip) & " ) "

    oBD.DbExecute (CStr(sSql))
    
    'TRaigo el proximo ID de Usuario
    sSql = " SELECT (NVL(MAX(IDROLJERARQUIAPERSONA),0)+ 1) FROM " & sDbAlias & " ROLJERARQUIAPERSONA "
    
    Set oRs = oBD.RsView(CStr(sSql))
    
    'Agrego le asigno un rol
    sSql = " INSERT INTO " & sDbAlias & "ROLJERARQUIAPERSONA (IDROLJERARQUIAPERSONA, IDPERSONA ,IDROL, IDJERAR ) "
    sSql = sSql & " VALUES ( " & oRs(0).Value & " , "
    sSql = sSql & idUsuario & " , " & Trim(idRol) & " ,1)"
    
    oBD.DbExecute (CStr(sSql))
    
    oBD.DbTransaction (dbCommit)
  
Else
    
    oBD.DbTransaction (dbBegin)
    
    'Me fijo si el username en caso de haberlo cambiado no este usado
    sSql = " SELECT IDPERSONA FROM " & sDbAlias & " PERSONAS "
    sSql = sSql & " WHERE IDPERSONA NOT IN (" & Trim(idUsuario) & ") "
    sSql = sSql & " AND USERNAME = '" & Trim(sUserName) & "' "
    
    Set oRs = oBD.RsView(CStr(sSql))
    
    If oBD.RsHasRecords(oRs) Then
        Set oXml = Nothing
        Set oRs = Nothing
        UsuariosActua = "-1"
        Exit Function
    End If
    
    'Actualizo los datos del Usuario
    sSql = " UPDATE " & sDbAlias & "PERSONAS "
    sSql = sSql & " SET USERNAME = '" & UCase(Trim(sUserName)) & "' "
    
    If Trim(sNombre) <> "" Then
        sSql = sSql & " , NOMBRE = '" & Trim(sNombre) & "' "
    Else
        sSql = sSql & " , NOMBRE = NULL "
    End If
    
    
    If Trim(sApellido) <> "" Then
        sSql = sSql & " , APELLIDO = '" & Trim(sApellido) & "' "
    Else
        sSql = sSql & " , APELLIDO = NULL "
    End If
    
    sSql = sSql & " , EMAIL = '" & Trim(sEmail) & "' "
    
    If Trim(sDescrip) <> "" Then
        sSql = sSql & " , DESCRIP = '" & Trim(sDescrip) & "' "
    Else
        sSql = sSql & " , DESCRIP = NULL "
    End If
    
    sSql = sSql & " WHERE IDPERSONA = " & Trim(idUsuario)
    
    
    oBD.DbExecute (CStr(sSql))

    'Actualizo el rol del Usuario
    sSql = " UPDATE " & sDbAlias & "ROLJERARQUIAPERSONA "
    sSql = sSql & " SET IDROL = " & Trim(idRol)
    sSql = sSql & " WHERE IDPERSONA = " & Trim(idUsuario)
       
    oBD.DbExecute (CStr(sSql))


    oBD.DbTransaction (dbCommit)

End If



UsuariosActua = 1
  
Set oRs = Nothing

Exit Function
CapturarError:
    oBD.DbTransaction (dbRollback)
    ErrorHandler "UsuariosActua"
        
End Function

Public Function UsuariosBaja( _
        ByVal idUsuario As String _
            ) As String

Dim sSql As String
 
On Error Resume Next

oBD.DbTransaction (dbBegin)
 
sSql = " DELETE FROM " & sDbAlias & "ROLJERARQUIAPERSONA "
sSql = sSql & " WHERE IDPERSONA = " & Trim(idUsuario)

oBD.DbExecute (CStr(sSql))
 
 
sSql = " DELETE FROM " & sDbAlias & "PERSONAS "
sSql = sSql & " WHERE IDPERSONA = " & Trim(idUsuario)

oBD.DbExecute (CStr(sSql))
 

 
 
If Err.Number = 0 Then
    oBD.DbTransaction (dbCommit)
    UsuariosBaja = 1
Else
    oBD.DbTransaction (dbRollback)
    UsuariosBaja = -1
End If

End Function

